{-# OPTIONS -Wall #-}

--------------------------------------------------------------------------------
-- |
-- Module      :  Text.PrettyExprHPJ.MosML
-- Copyright   :  (c) Stephen Tetley 2012
-- License     :  BSD3
--
-- Maintainer  :  stephen.tetley@gmail.com
-- Stability   :  unstable
-- Portability :  GHC
--
-- ML operator and expression pretty printers with associated 
-- fixity and associativity.
--
-- Precedence levels and fixity are taken from the Moscow ML
-- reference.
--
--------------------------------------------------------------------------------

module Text.PrettyExprHPJ.MosML
  (
  -- * Re-export DocE
    DocE(..)

  -- * Unparse a DocE
  , unparse

  -- * Literals
  , literal

  -- * Moscow ML operators and expressions


  -- ** Precedence 8
  , funAppB1
  , funAppB



  -- ** Precedence 7
  , idivideB
  , fdivideB
  , multiplyB
  , modB

  -- ** Precedence 6
  , addB
  , subtractB
  , concatenateB

  -- ** Precedence 5
  , listConsB
  , listAppendB


  -- ** Precedence 4
  , equalB
  , notEqualB
  , lessThanB
  , lessThanEqB
  , greaterThanB
  , greaterThanEqB


  -- ** Precedence 3
  , assignB
  , composeB

  -- ** Precedence 0
  , beforeB


  ) where

import Text.PrettyExprHPJ

import Text.PrettyPrint                         -- package: pretty
       

-- | Run an unparser for ML-like language expressions.
-- 
-- The Moscow ML ref has a maximum precendence level of 7 for
-- operators. We need 1 more for application, plus we need to
-- instantiate the pretty printer with one more again 
-- (9 in total).
--
unparse :: DocE -> Doc
unparse = unparser $ makeUnparser 9




--------------------------------------------------------------------------------
-- Precedence 8


funAppB1                :: DocE -> DocE -> DocE
funAppB1                = Binary (infixL 8) (noSpace " ")

funAppB                 :: DocE -> [DocE] -> DocE
funAppB d []            = d
funAppB d [e]           = d `funAppB1` e
funAppB d (e:es)        = d `funAppB1` e `funAppB` es



--------------------------------------------------------------------------------
-- Precedence 7


-- | Floating-point division operator.
-- 
-- > / (infixl 7)
--
fdivideB                :: DocE -> DocE -> DocE
fdivideB                = Binary (infixL 7) (spaced "/")



-- | Integer division operator.
-- 
-- > div (infixl 7)
--
idivideB                :: DocE -> DocE -> DocE
idivideB                = Binary (infixL 7) (spaced "div")


-- | Multiplication operator.
-- 
-- > * (infixl 7)
--
multiplyB              :: DocE -> DocE -> DocE
multiplyB              = Binary (infixL 7) (spaced "*")




-- | Integer modulus operator.
-- 
-- > mod (infixl 7)
--
modB                    :: DocE -> DocE -> DocE 
modB                    = Binary (infixL 7) (spaced "mod")

--------------------------------------------------------------------------------
-- Precedence 6


-- | Addition operator.
-- 
-- > + (infixl 6)
--
addB                    :: DocE -> DocE -> DocE
addB                    = Binary (infixL 6) (spaced "+")



-- | Subtraction operator.
-- 
-- > - (infixl 6)
--
subtractB               :: DocE -> DocE -> DocE 
subtractB               = Binary (infixL 6) (noSpace "-")

-- | String concatenation operator.
-- 
-- > ^ (infixl 6)
--
concatenateB            :: DocE -> DocE -> DocE
concatenateB            = Binary (infixL 6) (spaced "^")


--------------------------------------------------------------------------------
-- Precedence 5


-- | List cons operator.
-- 
-- > :: (infixr 5)
--
listConsB               :: DocE -> DocE -> DocE
listConsB               = Binary (infixR 5) (noSpace "::")

-- | List append operator.
-- 
-- > @ (infixr 5)
--
listAppendB             :: DocE -> DocE -> DocE
listAppendB             = Binary (infixR 5) (noSpace "@")


--------------------------------------------------------------------------------
-- Precedence 4

-- | Equality testing operator (left-associative).
--
-- > = (infixl 4)
--
equalB                  :: DocE -> DocE -> DocE 
equalB                  = Binary (infixL 4) (spaced "=")

-- | Inequality testing operator.
--
-- > <> (infixl 4)
--
notEqualB               :: DocE -> DocE -> DocE
notEqualB               = Binary (infixL 4) (spaced "<>")


-- | Less than operator (non-associative).
-- 
-- > < (infixl 4)
--
lessThanB               :: DocE -> DocE -> DocE
lessThanB               = Binary (infixL 4) (spaced "<")


-- | Less than or equal operator (non-associative).
-- 
-- > <= (infixl 4)
--
lessThanEqB             :: DocE -> DocE -> DocE
lessThanEqB             = Binary (infixL 4) (spaced "<=")

-- | Greater than operator (non-associative).
-- 
-- > > (infixl 4)
--
greaterThanB            :: DocE -> DocE -> DocE
greaterThanB            = Binary (infixL 4) (spaced ">")


-- | Greater than or equal operator (non-associative).
-- 
-- > >= (infixl 4)
--
greaterThanEqB          :: DocE -> DocE -> DocE
greaterThanEqB          = Binary (infixL 4) (spaced ">=")


--------------------------------------------------------------------------------
-- Precedence 3

-- | Assignment operator.
--
-- > := (infixl 3)
--
assignB                 :: DocE -> DocE -> DocE
assignB                 = Binary (infixL 3) (spaced ":=")

-- | Composition operator.
--
-- > o (infixl 3)
--
composeB                :: DocE -> DocE -> DocE
composeB                = Binary (infixL 3) (spaced "o")


--------------------------------------------------------------------------------
-- Precedence 0

-- | before operator.
--
-- > before (infixl 0)
--
beforeB                 :: DocE -> DocE -> DocE
beforeB                 = Binary (infixL 0) (spaced "before")

